home *** CD-ROM | disk | FTP | other *** search
/ Kompuutteri K-CD 2002 #1 / K-CD_2002-01.iso / Delphi / INSTALL / program files / Borland / Delphi6 / Demos / Football / Main.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-05-22  |  14.1 KB  |  597 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   Menus, ExtCtrls, StdCtrls, ComCtrls, MMSystem;
  8.  
  9. const
  10.   RBTOP : integer = 58;
  11.   RBMIDDLE  : integer = 74;
  12.   RBBOTTOM  : integer = 90;
  13.   RBLEFT  : integer = 36;
  14.   TACKLETOP  : integer = 59;
  15.   TACKLEMIDDLE  : integer = 75;
  16.   TACKLEBOTTOM  : integer = 91;
  17.   TACKLEROW1  : integer = 104;
  18.   TACKLEROW2  : integer = 148;
  19.   TACKLEROW3  : integer = 236;
  20.  
  21. type
  22.   spot = record
  23.     player : TLabel;
  24.     rb : boolean;
  25.   end;
  26.   
  27.   TMainForm = class(TForm)
  28.     Image7: TImage;
  29.     HomeDisplay: TLabel;
  30.     TimeDisplay: TLabel;
  31.     VisitorDisplay: TLabel;
  32.     Runningback: TLabel;
  33.     Tackler1: TLabel;
  34.     Tackler2: TLabel;
  35.     Tackler3: TLabel;
  36.     Tackler4: TLabel;
  37.     Tackler5: TLabel;
  38.     HomeLabel: TLabel;
  39.     TimeLabel: TLabel;
  40.     VisitorLabel: TLabel;
  41.     MoveForward: TImage;
  42.     MoveUp: TImage;
  43.     MoveDown: TImage;
  44.     Kick: TImage;
  45.     Score: TImage;
  46.     Label2: TLabel;
  47.     Label1: TLabel;
  48.     Label3: TLabel;
  49.     DownDisplay: TLabel;
  50.     FieldPosDisplay: TLabel;
  51.     YTGDisplay: TLabel;
  52.     DownLabel: TLabel;
  53.     FieldPosLabel: TLabel;
  54.     YTGLabel: TLabel;
  55.     MoveBack: TImage;
  56.     OnOffSwitch: TTrackBar;
  57.     Computer: TButton;
  58.     Timer: TTimer;
  59.     MainMenu1: TMainMenu;
  60.     File1: TMenuItem;
  61.     Exit1: TMenuItem;
  62.     Help1: TMenuItem;
  63.     About1: TMenuItem;
  64.     Clock: TTimer;
  65.     procedure About1Click(Sender: TObject);
  66.     procedure Exit1Click(Sender: TObject);
  67.     procedure FormKeyPress(Sender: TObject; var Key: Char);
  68.     procedure MoveUpClick(Sender: TObject);
  69.     procedure MoveDownClick(Sender: TObject);
  70.     procedure MoveForwardClick(Sender: TObject);
  71.     procedure MoveBackClick(Sender: TObject);
  72.     procedure ComputerClick(Sender: TObject);
  73.     procedure ClockTimer(Sender: TObject);
  74.     procedure TimerTimer(Sender: TObject);
  75.     procedure ScoreMouseUp(Sender: TObject; Button: TMouseButton;
  76.       Shift: TShiftState; X, Y: Integer);
  77.     procedure ScoreMouseDown(Sender: TObject; Button: TMouseButton;
  78.       Shift: TShiftState; X, Y: Integer);
  79.     procedure KickClick(Sender: TObject);
  80.     procedure OnOffSwitchChange(Sender: TObject);
  81.   private
  82.     { Private declarations }
  83.     field : array[0..9]of array[0..2] of spot;  // the X and Y coordinates of the field
  84.     rbx, rby : integer;      // the X and Y coordinates of the runningback
  85.     running : boolean;
  86.     LastSack : TLabel;
  87.     YardsToGo : integer;
  88.     Down : integer;
  89.     FieldPosition : integer;
  90.     Home : integer;
  91.     Visitor : integer;
  92.     Quarter : integer;
  93.     TimeLeft : double;
  94.     procedure ShowField(visible : boolean);
  95.     procedure ResetField;
  96.     procedure Sacked(Player : TLabel);
  97.     procedure ShowDisplay(visible : boolean);
  98.     procedure TogglePlay( toggle : boolean );
  99.     procedure ResetGame;
  100.   public
  101.     { Public declarations }
  102.   end;
  103.  
  104. var
  105.   MainForm: TMainForm;
  106.  
  107. implementation
  108.  
  109. uses about;
  110.  
  111. {$R *.dfm}
  112.  
  113. procedure TMainForm.About1Click(Sender: TObject);
  114. begin
  115.   AboutForm.ShowModal;
  116. end;
  117.  
  118. procedure TMainForm.Exit1Click(Sender: TObject);
  119. begin
  120.   Application.Terminate;
  121. end;
  122.  
  123. procedure TMainForm.FormKeyPress(Sender: TObject; var Key: Char);
  124. begin
  125.   case Key of
  126.     'i':
  127.       MoveUpClick(Sender);
  128.     'k':
  129.       MoveDownClick(Sender);
  130.     'l':
  131.       MoveForwardClick(Sender);
  132.     'j':
  133.       MoveBackClick(Sender);
  134.   end;
  135. end;
  136.  
  137. procedure TMainForm.MoveUpClick(Sender: TObject);
  138. begin
  139.   if ((OnOffSwitch.Position = 2) or (LastSack <> Nil)) then
  140.     exit;
  141.  
  142.   if not running then
  143.     TogglePlay(true);
  144.  
  145.   if (Runningback.Top = RBTOP) then
  146.     exit; // already as up as it gets
  147.  
  148.   if (field[rbx][rby-1].player <> Nil) then
  149.   begin
  150.     Sacked(field[rbx][rby-1].player);
  151.     exit;
  152.   end;
  153.  
  154.   if (Runningback.Top = RBBOTTOM) then
  155.     Runningback.Top := RBMIDDLE
  156.   else if (Runningback.Top = RBMIDDLE) then
  157.     Runningback.Top := RBTOP;
  158.  
  159.   field[rbx][rby].player := Nil;
  160.   field[rbx][rby].rb := false;
  161.   dec( rby );
  162.   field[rbx][rby].player := Runningback;
  163.   field[rbx][rby].rb := true;
  164. end;
  165.  
  166. procedure TMainForm.MoveDownClick(Sender: TObject);
  167. begin
  168.     if ((OnOffSwitch.Position = 2) or (LastSack <> Nil)) then
  169.         exit;
  170.  
  171.     if not running then
  172.         TogglePlay(true);
  173.  
  174.     if (Runningback.Top = RBBOTTOM) then
  175.         exit; // already as down as it gets
  176.  
  177.     if (field[rbx][rby+1].player <> Nil) then
  178.     begin
  179.         Sacked(field[rbx][rby+1].player);
  180.         exit;
  181.     end;
  182.  
  183.     if (Runningback.Top = RBTOP) then
  184.         Runningback.Top := RBMIDDLE
  185.     else if (Runningback.Top = RBMIDDLE) then
  186.         Runningback.Top := RBBOTTOM;
  187.  
  188.     field[rbx][rby].player := Nil;
  189.     field[rbx][rby].rb := false;
  190.     inc( rby );
  191.     field[rbx][rby].player := Runningback;
  192.     field[rbx][rby].rb := true;
  193. end;
  194.  
  195. procedure TMainForm.MoveForwardClick(Sender: TObject);
  196. begin
  197.   if ((OnOffSwitch.Position = 2) or (LastSack <> Nil)) then
  198.     exit;
  199.  
  200.   if not running then
  201.     TogglePlay(true);
  202.  
  203.   if (Runningback.Left < TACKLEROW3 - 2) then
  204.   begin
  205.     if (field[rbx+1][rby].player <> Nil) then
  206.     begin
  207.       Sacked(field[rbx+1][rby].player);
  208.       exit;
  209.     end;
  210.     field[rbx][rby].player := Nil;
  211.     field[rbx][rby].rb := false;
  212.     Runningback.Left := Runningback.Left + 22;
  213.     inc( rbx );
  214.   end
  215.   else
  216.   begin
  217.     if (field[0][rby].player <> Nil) then
  218.     begin
  219.         Sacked(field[0][rby].player);
  220.         exit;
  221.     end;
  222.     field[rbx][rby].player := Nil;
  223.     field[rbx][rby].rb := false;
  224.     Runningback.Left := RBLEFT;
  225.     rbx := 0;
  226.   end;
  227.  
  228.   dec( YardsToGo );
  229.   inc( FieldPosition );
  230.   if (FieldPosition = 100) then
  231.   begin
  232.     sndPlaySound('td.wav', SND_SYNC);
  233.     running := false;
  234.     ShowField(false);
  235.     inc( Home, 7);
  236.     HomeDisplay.Caption := inttostr(Home);
  237.     FieldPosition:=80;  // Starting position for visitor
  238.     Down := 1;
  239.     YardsToGo := 10;
  240.     Computer.Visible := true;
  241.     exit;
  242.   end;
  243.   field[rbx][rby].player := Runningback;
  244.   field[rbx][rby].rb := true;
  245. end;
  246.  
  247. procedure TMainForm.MoveBackClick(Sender: TObject);
  248. begin
  249.   if ((OnOffSwitch.Position = 2) or (LastSack <> Nil)) then
  250.     exit;
  251.  
  252.   if not running then
  253.     TogglePlay(true);
  254.   if(FieldPosition > 0) then
  255.   begin
  256.     if (Runningback.Left > RBLEFT + 2) then
  257.     begin
  258.       if (field[rbx-1][rby].player <> Nil) then
  259.       begin
  260.         Sacked(field[rbx-1][rby].player);
  261.         exit;
  262.       end;
  263.       field[rbx][rby].player := Nil;
  264.       field[rbx][rby].rb := false;
  265.       Runningback.Left := Runningback.Left - 22;
  266.       dec( rbx );
  267.     end
  268.     else
  269.     begin
  270.       if (field[9][rby].player <> Nil) then
  271.       begin
  272.         Sacked(field[9][rby].player);
  273.         exit;
  274.       end;
  275.       field[rbx][rby].player := Nil;
  276.       field[rbx][rby].rb := false;
  277.       Runningback.Left := TACKLEROW3;
  278.       rbx := 9;
  279.     end;
  280.  
  281.     Inc( YardsToGo );
  282.     Dec( FieldPosition );
  283.  
  284.     field[rbx][rby].player := Runningback;
  285.     field[rbx][rby].rb := true;
  286.   end;
  287. end;
  288.  
  289. procedure TMainForm.ResetField;
  290. var
  291.   x, y :integer;
  292. begin
  293.   TogglePlay(false);
  294.   LastSack := Nil;
  295.  
  296.   // empty the field
  297.   for y := 0 to 2 do
  298.     for x := 0 to 9 do
  299.     begin
  300.         field[x][y].player := Nil;
  301.         field[x][y].rb := false;
  302.     end;
  303.  
  304.   // initial locations of players
  305.   field[0][1].player := Runningback;
  306.   field[0][1].rb := true;
  307.   rbx := 0;
  308.   rby := 1;
  309.   field[3][0].player := Tackler1;
  310.   field[3][1].player := Tackler2;
  311.   field[3][2].player := Tackler3;
  312.   field[5][1].player := Tackler4;
  313.   field[9][1].player := Tackler5;
  314.  
  315.   Runningback.Left := RBLEFT;
  316.   Runningback.Top := RBMIDDLE;
  317.   Tackler1.Left := TACKLEROW1;
  318.   Tackler1.Top := TACKLETOP;
  319.   Tackler2.Left := TACKLEROW1;
  320.   Tackler2.Top := TACKLEMIDDLE;
  321.   Tackler3.Left := TACKLEROW1;
  322.   Tackler3.Top := TACKLEBOTTOM;
  323.   Tackler4.Left := TACKLEROW2;
  324.   Tackler4.Top := TACKLEMIDDLE;
  325.   Tackler5.Left := TACKLEROW3;
  326.   Tackler5.Top := TACKLEMIDDLE;
  327.  
  328.   ShowField(true);
  329. end;
  330.  
  331. procedure TMainForm.Sacked( Player: TLabel);
  332. begin
  333.   sndPlaySound('whistle.wav', SND_SYNC);
  334.   running := false;
  335.   LastSack := player;
  336.   if (YardsToGo <=0) then
  337.   begin
  338.     Down := 1;
  339.     YardsToGo := 10;
  340.   end
  341.   else
  342.   begin
  343.     inc( Down );
  344.     if (Down > 4) then
  345.     begin
  346.       sndPlaySound('whistle.wav', SND_SYNC);
  347.       Down := 1;  // First down for visitor
  348.       YardsToGo := 10;
  349.       Computer.Visible := true;
  350.     end;
  351.   end;
  352. end;
  353.  
  354. procedure TMainForm.ShowDisplay(visible: boolean);
  355. begin
  356.   DownLabel.Visible := visible;
  357.   FieldPosLabel.Visible := visible;
  358.   YTGLabel.Visible := visible;
  359.   DownDisplay.Visible := visible;
  360.   FieldPosDisplay.Visible := visible;
  361.   YTGDisplay.Visible := visible;
  362. end;
  363.  
  364. procedure TMainForm.ShowField(visible: boolean);
  365. begin
  366.   Runningback.Visible := visible;
  367.   Tackler1.Visible := visible;
  368.   Tackler2.Visible := visible;
  369.   Tackler3.Visible := visible;
  370.   Tackler4.Visible := visible;
  371.   Tackler5.Visible := visible;
  372. end;
  373.  
  374. procedure TMainForm.TogglePlay(toggle: boolean);
  375. begin
  376.   running := toggle;
  377.   Timer.Enabled := toggle;
  378.   Clock.Enabled := toggle;
  379. end;
  380.  
  381. procedure TMainForm.ComputerClick(Sender: TObject);
  382. begin
  383.   ShowField(false);
  384.   Dec( FieldPosition, random(100) );
  385.   if (FieldPosition <= 0) then
  386.   begin
  387.     sndPlaySound('td.wav', SND_ASYNC);
  388.     inc( Visitor, 7);
  389.     VisitorDisplay.Caption := IntToStr(Visitor);
  390.     FieldPosition := 20;
  391.   end
  392.   else
  393.   begin
  394.     sndPlaySound('whistle.wav', SND_SYNC);
  395.     sndPlaySound('whistle.wav', SND_SYNC);
  396.   end;
  397.   Computer.Visible := false;
  398.   LastSack := Runningback; // hack to keep movement keys disabled
  399. end;
  400.  
  401. procedure TMainForm.ClockTimer(Sender: TObject);
  402. begin
  403.   if not running then
  404.     exit;
  405.  
  406.   sndPlaySound('tick.wav', SND_ASYNC);
  407.   TimeLeft := TimeLeft - 0.1;
  408.   TimeDisplay.Caption := FloatToStrF(TimeLeft, ffGeneral, 4, 4);
  409.  
  410.   if (TimeLeft <= 0) then
  411.   begin
  412.     inc( Quarter );
  413.     TimeLeft := 15;
  414.   end;
  415.   if (Quarter >= 5) then
  416.   begin
  417.     // game over
  418.     sndPlaySound('whistle.wav', SND_SYNC);
  419.     sndPlaySound('whistle.wav', SND_SYNC);
  420.     LastSack := Runningback; // hack to keep movement keys disabled
  421.     TogglePlay(false);
  422.     ShowField(false);
  423.     ShowDisplay(true);
  424.   end;
  425. end;
  426.  
  427. procedure TMainForm.TimerTimer(Sender: TObject);
  428. var
  429.   x, y, newx, newy, direction : integer;
  430. begin
  431.   newy := random(3);
  432.   y := newy;
  433.   newx := random(10);
  434.   x := newx;
  435.   direction := random(2); // 0 is for x, 1 is for y
  436.  
  437.   if not running then
  438.   begin
  439.     if (LastSack <> Nil) then
  440.       LastSack.Visible := not LastSack.Visible;
  441.     exit;
  442.   end;
  443.  
  444.   if (field[x][y].rb) then
  445.     exit; // can't move the runningback!
  446.  
  447.   if (field[x][y].player = Nil) then
  448.     exit; // no tacker at this spot
  449.  
  450.   if (field[x][y].player.Left <= RBLEFT) then
  451.     exit; // already at the endzone
  452.  
  453.   if (direction = 0)  then// we're moving horizontal
  454.   begin
  455.     if (x < rbx) then
  456.       newx := x + 1
  457.     else if (x > rbx) then
  458.       newx := x - 1
  459.     else
  460.       exit;
  461.     //  we're already horizontally lined up with rb
  462.   end
  463.   else if (direction = 1)  then// we're moving vertical
  464.   begin
  465.     if (y < rby) then
  466.       newy := y + 1
  467.     else if (y > rby) then
  468.       newy := y - 1
  469.     else
  470.       exit;
  471.     //  we're already vertically lined up with rb
  472.   end;
  473.  
  474.   if field[newx][newy].rb  then// got him!
  475.   begin
  476.     Sacked(field[x][y].player);
  477.     exit;
  478.   end;
  479.  
  480.   if (field[newx][newy].player = Nil) then// not blocked
  481.   begin
  482.     field[x][y].player.Left := field[x][y].player.Left - (22 * (x - newx));
  483.     field[x][y].player.Top := field[x][y].player.Top - (16 * (y - newy));
  484.     field[newx][newy].player := field[x][y].player;
  485.     field[x][y].player := Nil;
  486.   end;
  487. end;
  488.  
  489. procedure TMainForm.ScoreMouseUp(Sender: TObject; Button: TMouseButton;
  490.   Shift: TShiftState; X, Y: Integer);
  491. begin
  492.   if ((OnOffSwitch.Position = 2) or (running)) then
  493.     exit;
  494.  
  495.   ShowDisplay(false);
  496.   if not(Computer.Visible) then
  497.     ResetField;
  498. end;
  499.  
  500. procedure TMainForm.ScoreMouseDown(Sender: TObject; Button: TMouseButton;
  501.   Shift: TShiftState; X, Y: Integer);
  502. begin
  503.   if ((OnOffSwitch.Position = 2) or (running)) then
  504.     exit;
  505.  
  506.   if (Quarter = 5) then
  507.     exit;
  508.  
  509.   YTGDisplay.Caption := IntToStr(YardsToGo);
  510.  
  511.   if (FieldPosition <= 50) then
  512.   begin
  513.     FieldPosDisplay.Caption := IntToStr(FieldPosition) + ' <';
  514.   end
  515.   else
  516.   begin
  517.     FieldPosDisplay.Caption := '> ' + IntToStr(100 - FieldPosition);
  518.   end;
  519.  
  520.   DownDisplay.Caption := IntToStr(Down);
  521.  
  522.   ShowField(false);
  523.   ShowDisplay(true);
  524. end;
  525.  
  526. procedure TMainForm.KickClick(Sender: TObject);
  527. begin
  528.   if ((running) or (Down <> 4)) then
  529.     exit;  // button only valid just before fourth down
  530.  
  531.   ShowField(false);
  532.   inc(FieldPosition,random(100) );
  533.   if (FieldPosition >= 100) then
  534.   begin
  535.     sndPlaySound('td.wav', SND_SYNC);
  536.     inc( Home, 3 );
  537.     HomeDisplay.Caption := IntToStr(Home);
  538.     FieldPosition := 80;  // Starting position for visitor
  539.   end
  540.   else
  541.   begin
  542.     sndPlaySound('whistle.wav', SND_SYNC);
  543.     sndPlaySound('whistle.wav', SND_SYNC);
  544.   end;
  545.   Down := 1;  // first down for visitor
  546.   YardsToGo := 10;
  547.   Computer.Visible := true;
  548.   LastSack := Runningback; // hack to keep movement keys disabled
  549. end;
  550.  
  551. procedure TMainForm.OnOffSwitchChange(Sender: TObject);
  552. begin
  553.   case OnOffSwitch.Position of
  554.     1:
  555.     begin
  556.       Timer.Interval := 250;
  557.       HomeDisplay.Visible := true;
  558.       VisitorDisplay.Visible := true;
  559.       TimeDisplay.Visible := true;
  560.       ResetGame;
  561.     end;
  562.     2:
  563.     begin
  564.       ShowField(false);
  565.       HomeDisplay.Visible := false;
  566.       VisitorDisplay.Visible := false;
  567.       TimeDisplay.Visible := false;
  568.     end;
  569.     3:
  570.     begin
  571.       Timer.Interval := 100;
  572.       HomeDisplay.Visible := true;
  573.       VisitorDisplay.Visible := true;
  574.       TimeDisplay.Visible := true;
  575.       ResetGame;
  576.     end;
  577.   end;
  578. end;
  579.  
  580. procedure TMainForm.ResetGame;
  581. begin
  582.   YardsToGo := 10;
  583.   Down := 1;
  584.   FieldPosition := 20;
  585.   Home := 0;
  586.   Visitor := 0;
  587.   Quarter := 1;
  588.   TimeLeft := 15;
  589.   TimeDisplay.Caption := FloatToStrF(TimeLeft, ffGeneral, 4, 4);
  590.   HomeDisplay.Caption := IntToStr(Home);
  591.   VisitorDisplay.Caption := intToStr(Visitor);
  592.   randomize;
  593.   ResetField;
  594. end;
  595.  
  596. end.
  597.